home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
gnu
/
amiga
/
gnnln920.lha
/
conv.p
next >
Wrap
Text File
|
1992-06-14
|
9KB
|
310 lines
#!/c/perl
# convert pair of clib/proto header and fd file into an inline header
#
# (C) 1992 by Markus Wild
# <wild@nessie.cs.id.ethz.ch> or <wild@amiga.physik.unizh.ch>
#
# this tool requires PERL.
#
# 1.1 92-jun-04 now handles double arguments
#
# TODO: handle full ANSI declarations,
# eg. void qsort (void *, size_t, size_t, int (*)(const void *, const void *));
# Currently omit the declaration of the arguments of the function pointers,
# ie. in this example, use
# void qsort (void *, size_t, size_t, int (*)());
#
$#ARGV == 1 || die "Usage: $0 proto-file fd-file\n";
open(PROTO_F, $ARGV[0]) || die "Can't open $ARGV[0], $!";
open(FD_F, $ARGV[1]) || die "Can't open $ARGV[1], $!";
# set the input record separator to ; to be able to parse multiline
# declarations. This could get us into troubles with comments.. we will see
$/=";";
p_line: while (<PROTO_F>) {
#print "0: ",$_,"\n";
# skip proprocessor statements and comments
s/\n+/\n/g;
#print "01: ", $_, "\n";
s/(#.*\n)+//g;
#print "02: ", $_, "\n";
s/\/\*([^\*]*\*+)*\///g;
#print "03: ", $_, "\n";
s/^([^\n\(]+\n)+//g;
next if $_ eq "";
next unless /\(/;
# suppose this is a function declaration
# this `little' pattern filters out the return type and the argument
# line. The return type is quite tricky, since it can be a multi word
# type (like struct foo *), and we shouldn't overwrite the function
# name by matching against the return type... this seems to work, although
# I'm not completly sure it does in all cases.
#print "1: ",$_;
s/\(\s*\*/\(\*/g;
#print "2: ",$_;
s/\s+(\([^\*])/\(\1/g;
#print "3: ",$_;
/((\w+\s)*\w+\W+)(\w+)\((([^,\(\)]+|\([^\)]*\)|,|\s)*)\)([^;]*);/;
# %result_tab contains the type part written before the function name
$result_tab{$3} = $1;
# %result_tab_end contains the type part written after the closing parenthesis
chop $6;
$result_tab_end{$3} = $6;
# %arg_type_tab contains (later only) the type information for the arguments
$arg_type_tab{$3} = $4;
# compress the types, throw out not needed whitespace as much as we can
$result_tab{$3} =~ s/\s+/ /g;
$result_tab_end{$3} =~ s/\s+/ /g;
$result_tab_end{$3} =~ s/(\s+$)|(^\s+)//g;
$arg_type_tab{$3} =~ s/\s+/ /g;
$arg_type_tab{$3} =~ s/\s*,\s*/,/g;
$arg_type_tab{$3} =~ s/(\s+$)|(^\s+)//g;
}
# now parse the given fd file
# reset input record separator to newline for fd file
$/="\n";
$bias = 0;
$private = 0;
($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($lib_base_name = "${2}Base");
$lib_base_name[0] =~ tr/[a-z]/[A-Z]/;
f_line: while (<FD_F>) {
# strip terminating new line
chop;
# get rid of comments
/^\*/ && next f_line;
# parse commands
/^##base _(\w+)/ && ($lib_base_name = $1) && next f_line;
/^##bias (\d+)/ && ($bias = $1) && next f_line;
/^##public/ && (($private = 0), 1) && next f_line;
/^##private/ && ($private = 1) && next f_line;
# parse function
/^(\w+)\(([^\)]*)\)\(([^\)]*)\)/;
$reg_tab{$1} = $3;
$arg_name_tab{$1} = $2;
$bias_tab{$1} = $bias;
$bias += 6;
}
%base_types = (
'SysBase', 'struct ExecBase *',
'ConsoleDevice', 'struct Device *',
'TimerBase', 'struct Device *',
'DiskfontBase', 'struct Library *',
'DOSBase', 'struct DosLibrary *',
'IconBase', 'struct Library *',
'PotgoBase', 'struct Library *',
'TranslatorBase', 'struct Library *',
'XpkBase', 'struct Library *',
'XpkSubBase', 'struct Library *',
);
($lib_base_type = $base_types{$lib_base_name}) ||
($lib_base_type = "struct " . $lib_base_name . "* ");
# convert arg_name_tab and arg_type_tab into arg_tab. This is rather tricky...
foreach $func (sort keys(%arg_name_tab)) {
$_=$arg_name_tab{$func};
if ($_ eq "" || /^\s*void\s*/i)
{
# no arguments given, or just void or VOID
$arg_tab{$func} = "";
next;
}
else
{
# unpack arguments into array @names
@names = split(/,/, $arg_name_tab{$func});
# NOTE: this trick fails if someone specifies full prototypes for
# function pointers, ie. (.., (*func)(int, int, int), ...).
# Currently just one function in graphics.h does this, so it's
# not worth the hassle to do it `right'.
@types = split(/,/, $arg_type_tab{$func});
# @types may still contain argument names, if they were specified
# in the proto file. This is a tricky task, separate the optional
# argument name...
foreach $i (0 .. $#types) {
@words = split(/ /,$types[$i]);
$wi=$#words;
word_loop: while ($wi > 0)
{
if ($words[$wi] =~ /[\(\)]/ && !($words[$wi - 1] =~ /[\(\)]/))
{
last word_loop;
}
elsif (!($words[$wi] =~ /[\(\)]/))
{
last word_loop;
}
$wi--;
}
# here come heuristics... (do we have a name to write over or
# do we have to append a new element?)
if ($words[$wi] eq "int" ||
$words[$wi] eq "long" ||
$words[$wi] eq "short" ||
$words[$wi] eq "char" ||
$words[$wi] eq "*")
{
$wi++;
}
($words[$wi] =~ s/(\W*)(\w+)(.*)/\1$names[$i]\3/) ||
($words[$wi] = $names[$i]);
$types[$i] = "@words";
}
$arg_tab{$func} = join("|", @types);
}
}
# now output the real file
($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($def = $2 . "_H");
$def =~ s/_protos//;
$def =~ tr/[a-z]/[A-Z]/;
print "#ifndef _INLINE_$def\n#define _INLINE_$def\n\n";
print "#include <sys/cdefs.h>\n";
print "#include <inline/stubs.h>\n";
# this is for C++ support, it does `extern "C" {' if __cplusplus is defined
print "\n__BEGIN_DECLS\n\n";
print "#ifndef BASE_EXT_DECL\n";
print "#define BASE_EXT_DECL extern $lib_base_type $lib_base_name;\n";
print "#endif\n";
print "#ifndef BASE_PAR_DECL\n";
print "#define BASE_PAR_DECL\n";
print "#define BASE_PAR_DECL0 void\n";
print "#endif\n";
print "#ifndef BASE_NAME\n";
print "#define BASE_NAME $lib_base_name\n";
print "#endif\n\n";
foreach $func (sort keys(%result_tab)) {
# this happens if the clib/ file defines functions that only exist in amiga.lib
next if $bias_tab{$func} == 0;
print "static __inline ",$result_tab{$func},"\n";
if ($arg_tab{$func} eq "")
{
print $func," (BASE_PAR_DECL0)\n{\n";
}
else
{
print $func," (BASE_PAR_DECL ",join(",", split(/\|/, $arg_tab{$func})),")\n{\n";
}
print " BASE_EXT_DECL\n";
if (!($result_tab{$func} =~ /^\s*void\s*$/i))
{
print " register $result_tab{$func} _res $result_tab_end{$func} __asm(\"d0\");\n";
}
print " register ${lib_base_type}a6 __asm(\"a6\") = BASE_NAME;\n";
@args = split(/\|/, $arg_tab{$func});
@names = split(/,/, $arg_name_tab{$func});
@regs = split(/[\/,]/, $reg_tab{$func});
$warn_a4a5 = 0;
$owe_nl = 0;
if ($#args >= 0)
{
# map the fd given register list to the arguments. If there wasn't
# DOUBLE/double, then this mapping would be 1:1, but a double variable
# is specified as taking d0/d1 in the fd file, while gcc only wants to
# see the d0.
$i = 0;
$ri = 0;
@reg_args = ();
while ($i <= $#args)
{
$reg_args[$i] = $regs[$ri];
# double, but not double pointers, skip one register
if ($args[$i] =~ /double[^\*]*$/i)
{
$ri+=2;
}
else
{
$ri++;
}
$decl = $args[$i];
$decl =~ s/(\W)$names[$i](\W?)/\1$reg_args[$i]\2/;
print " register $decl __asm(\"$reg_args[$i]\") = $names[$i];\n";
$i++;
}
}
printf " __asm __volatile (\"jsr a6@(-0x%x)\"\n", $bias_tab{$func};
if ($result_tab{$func} =~ /^\s*void\s*$/i)
{
print " : /* no output */\n";
}
else
{
print " : \"=r\" (_res)\n";
}
if ($#args == -1)
{
print " : \"r\" (a6)\n";
}
else
{
print " : \"r\" (a6)";
foreach $r (@reg_args) {
print ", \"r\" ($r)";
}
print "\n";
}
@clobb=("d0", "d1", "a0", "a1");
push (@clobb, @regs);
@clobb = sort(@clobb);
print " : ";
foreach $i (0 .. $#clobb) {
(($clobb[$i] ne $clobb[$i+1]) && ($i != $#clobb) && (print "\"$clobb[$i]\",")) ||
($i == $#clobb && (print "\"$clobb[$i]\");\n"));
}
# hack.. for all arguments addressed via address registers, fake a value change
foreach $i (0 .. $#regs) {
($regs[$i] =~ /a[0-5]/) &&
(print " *(char *)$regs[$i] = *(char *)$regs[$i];") && ($owe_nl= 1);
($regs[$i] =~ /a[45]/) && ($warn_a4a5 = 1);
}
print STDERR "Warning: $func uses a4 or a5, add code to save/restore them!\n"
if $warn_a4a5;
print "\n" if ($owe_nl);
print " return _res;\n" if (!($result_tab{$func} =~ /^\s*void\s*$/i));
print "}\n";
}
print "#undef BASE_EXT_DECL\n";
print "#undef BASE_PAR_DECL\n";
print "#undef BASE_PAR_DECL0\n";
print "#undef BASE_NAME\n";
print "\n__END_DECLS\n\n";
print "#endif /* _INLINE_$def */\n";